Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/blob/blob_tes.frm

Text File | 1995-09-06 | 8KB | 279 lines

VERSION 2.00
Begin Form BLOB_Test
   BackColor       =   &H8000000F&
   Caption         =   "BLOB Test Form"
   ClientHeight    =   4290
   ClientLeft      =   810
   ClientTop       =   1470
   ClientWidth     =   6375
   Height          =   4695
   Left            =   750
   LinkTopic       =   "Form1"
   ScaleHeight     =   4290
   ScaleWidth      =   6375
   Top             =   1125
   Width           =   6495
   Begin CommandButton Command4
      Caption         =   "Add New Record"
      Height          =   372
      Left            =   2160
      TabIndex        =   10
      Top             =   3360
      Width           =   1692
   End
   Begin TextBox Text2
      DataField       =   "Input_Size"
      DataSource      =   "Data1"
      Enabled         =   0   'False
      Height          =   288
      Index           =   2
      Left            =   120
      TabIndex        =   9
      Top             =   3120
      Width           =   972
   End
   Begin TextBox Text2
      DataField       =   "File_Name"
      DataSource      =   "Data1"
      Enabled         =   0   'False
      Height          =   288
      Index           =   1
      Left            =   120
      TabIndex        =   8
      Top             =   2760
      Width           =   6012
   End
   Begin TextBox Text2
      DataField       =   "CNT"
      DataSource      =   "Data1"
      Enabled         =   0   'False
      Height          =   288
      Index           =   0
      Left            =   120
      TabIndex        =   7
      Top             =   2400
      Width           =   972
   End
   Begin CommandButton Command3
      Caption         =   "Write File"
      Height          =   372
      Left            =   4440
      TabIndex        =   4
      Top             =   1800
      Width           =   1812
   End
   Begin CommandButton Command2
      Caption         =   "Read File"
      Height          =   372
      Left            =   2400
      TabIndex        =   3
      Top             =   1800
      Width           =   1812
   End
   Begin TextBox Text1
      Height          =   288
      Index           =   1
      Left            =   120
      TabIndex        =   2
      Top             =   1320
      Width           =   6132
   End
   Begin PictureBox CMDialog1
      Height          =   480
      Left            =   5880
      ScaleHeight     =   450
      ScaleWidth      =   1170
      TabIndex        =   11
      Top             =   0
      Width           =   1200
   End
   Begin CommandButton Command1
      Caption         =   "Get File Name"
      Height          =   372
      Left            =   120
      TabIndex        =   1
      Top             =   1800
      Width           =   2052
   End
   Begin Data Data1
      Caption         =   "Data1"
      Connect         =   ""
      DatabaseName    =   "BLOBTEST.MDB"
      Exclusive       =   0   'False
      Height          =   270
      Left            =   2040
      Options         =   0
      ReadOnly        =   0   'False
      RecordSource    =   "Blob_Test_Table"
      Top             =   3840
      Width           =   1872
   End
   Begin TextBox Text1
      Height          =   288
      Index           =   0
      Left            =   120
      TabIndex        =   0
      Top             =   480
      Width           =   6132
   End
   Begin Label Label1
      BackColor       =   &H8000000F&
      Caption         =   "Output File && Path Name"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   228
      Index           =   1
      Left            =   120
      TabIndex        =   6
      Top             =   1080
      Width           =   3132
   End
   Begin Label Label1
      BackColor       =   &H8000000F&
      Caption         =   "Input File && Path Name"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   228
      Index           =   0
      Left            =   120
      TabIndex        =   5
      Top             =   240
      Width           =   3132
   End
End

Option Explicit


Declare Function GetModuleFileName Lib "Kernel" (ByVal hModule As Integer, ByVal lpFilename As String, ByVal nSize As Integer) As Integer

Sub Command1_Click ()
    CMDialog1.Action = 1

    Text1(0) = CMDialog1.Filename
    Text1(1) = "C:\TEMP\" & CMDialog1.Filetitle

End Sub

Sub Command2_Click ()

    If Data1.Recordset.RecordCount = 0 Then
    Data1.Recordset.AddNew
    Data1.Recordset.Update
    End If

    If (Len(Text1(0)) = 0) Then
    MsgBox "Require File Name To Read." & Chr(10) & "Select 'Get File Name' first."
    Exit Sub
    End If

    ReadBigFile (Text1(0))
End Sub

Sub Command3_Click ()

    If (Len(Text1(1)) = 0) Then
    MsgBox "Require File Name To Read." & Chr(10) & "Select 'Get File Name' first or edit 'Output File Name'."
    Exit Sub
    End If

    WriteBigFile (Text1(1))
End Sub

Sub Command4_Click ()
    Data1.Recordset.AddNew
    Data1.Recordset.Update
End Sub

Sub Form_Load ()
    Dim temp As String

    temp = Left$(App.Path, 1)
    ChDrive temp
    ChDir App.Path

End Sub

Sub ReadBigFile (FName As String)
'AppendChunk Method Example
'This example uses AppendChunk with a data control to save the contents of a separate file into a field.  You would call this
'procedure with the path and name of the file you want to put into your database.  This procedure works for either Memo or Long
'Binary fields.

    Dim TotalSize As Long, CurChunk As String
    Dim I As Integer, FNum As Integer, ChunkSize As Integer

    Screen.MousePointer = 11

    ChunkSize = 12000       ' Set size of chunk.
    Data1.Recordset.Edit    ' Enter Edit mode.
    Data1.Recordset.Fields(Field_Name) = "" ' Clear Comments field.
    FNum = FreeFile ' Get free file number.
    Open FName For Binary As #FNum  ' Open the file.
    TotalSize = LOF(FNum)

    Text2(1) = FName
    Text2(2) = TotalSize

    Do While Not EOF(FNum)
        If TotalSize - Seek(FNum) < ChunkSize Then
            ChunkSize = TotalSize - Seek(FNum)
            If ChunkSize <= 0 Then Exit Do
        End If
        CurChunk = String$(ChunkSize + 1, 32)
        Get #FNum, , CurChunk   ' Read chunk from file.

    ' Append chunk to Comments field.
        Data1.Recordset.Fields(Field_Name).AppendChunk (CurChunk)
    Loop
    Data1.Recordset.Update  ' Save the record.
    Close FNum      ' Close the file.

    Screen.MousePointer = 0
    MsgBox "Stored file " & FName & Chr(10) & "Input file size = " & TotalSize & Chr(10) & "Into '" & Field_Name & "'."
End Sub

Sub WriteBigFile (FName As String)
'GetChunk and FieldSize Methods Example
'This example uses GetChunk with a data control to save the contents of a field to a separate file.  You would call this procedure
'with the path and name of the file where you want to save the contents of the field.  This procedure works for either text or binary
'fields.


    Dim NumChunks As Long, TotalSize As Long
    Dim RemChunk As Integer, CurSize As Integer
    Dim I As Integer, FNum As Integer, CurChunk As String

    Screen.MousePointer = 11

    ChunkSize = 2000        ' Set size of chunk.
    ' Get field size.
    TotalSize = Data1.Recordset.Fields(Field_Name).FieldSize()
    NumChunks = TotalSize \ ChunkSize       ' Set number of chunks.
    ' Set number of remaining bytes.
    RemChunk = TotalSize Mod ChunkSize
    ' Set starting size of chunk.
    CurSize = ChunkSize
    FNum = FreeFile ' Get free file number.
    Open FName For Binary As #FNum  ' Open the file.
    For I = 0 To NumChunks
        If I = NumChunks Then CurSize = RemChunk
        CurChunk = Data1.Recordset.Fields(Field_Name).GetChunk(I * ChunkSize, CurSize)
        Put #FNum, , CurChunk   ' Write chunk to file.
    Next I
    TotalSize = LOF(FNum)
    Close FNum

    Screen.